home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / demo100.arc / DEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-09-06  |  9.7 KB  |  258 lines
  1. {----------------------------------------------------------------------------}
  2. {                                                                            }
  3. {   Slideshow type of display for Color Graphics Adapter pictures in medium  }
  4. { resolution mode.  Compatible with pictures BSAVEd with BASICA.  Written in }
  5. { Turbo Pascal version 3.0 .  Usage is: "demo list" where 'demo' is the name }
  6. { of the .COM file created by compiling this code and 'list' is an ASCII     }
  7. { file containing the names of the pictures to be loaded and displayed.  It  }
  8. { loads pictures much faster than BASICA.  Loads pictures listed in 'list'   }
  9. { until end of list.  'List' specifies 'filename', 'duration' of display in  }
  10. { milliseconds ( 1000 -> 1 sec. ), and the 'palette' number ( 0 to 3 ) on    }
  11. { each line.  Must be listed in pure ASCII.                                  }
  12. {   Typing "demo makelist" will activate the list file making utility,       }
  13. { Makelist.Com, which must be on the default drive.  This will allow one     }
  14. { to create a list file for input to Demo.Com.  At the end of makelist the   }
  15. { user is asked if (s)he wants to return to demo.  A "y" response will run   }
  16. { demo again.  Again, Demo.Com must be on the same disk in the default drive }
  17. { or program will not work.  Makelist can be run as a stand alone program    }
  18. { also.  After one creates a list file, control can be transferred to demo   }
  19. { as usual.  At all times when transferring control to demo the name of the  }
  20. { newly created list file is passed to demo on the command line so user will }
  21. { not have to reenter it.                                                    }
  22. {   The source code included in this package for those who are interested.   }
  23. { Programming is too much fun to keep to oneself so use these techniques in  }
  24. { any manner you see fit in your own programs but I reserve the right to     }
  25. { reuse these and any outgrowths of these programs in the future for fun or  }
  26. { profit.                                                                    }
  27. {                                                                            }
  28. {                                                                            }
  29. {    If you find this useful and have it in your heart to contribute to the  }
  30. { cause of affordable software please send $10.00 to the following:          }
  31. {                                                                            }
  32. {              Joe Halbleib                                                  }
  33. {              36229 Magellan Dr.                                            }
  34. {              Fremont, CA. 94536                                            }
  35. {                                                                            }
  36. {   Contributors may request special versions of program for an extra cost   }
  37. { to be negotiated at time of request.                                       }
  38. {                                                                            }
  39. {----------------------------------------------------------------------------}
  40.  
  41.  
  42.  
  43.  
  44.  
  45. {$C-}     { disable control char interpretation and thus user interupt }
  46.  
  47. program Demo;
  48.  
  49. type
  50.  
  51.   PictureRec = record
  52.                  screenful : array[1..16380] of byte { actual bytes shown on }
  53.                end;                                  { screen in med res     }
  54.  
  55.   BsaveRec   = record
  56.                  BsaveJunk : array[1..7] of byte; { <- not sure what these 7 }
  57.                  Screen    : PictureRec           { bytes are for but might  }
  58.                end;                               { be location in memory to }
  59.                                                   { BLOAD in BASICA or color }
  60.                                                   { palette or both!         }
  61.  
  62.   filenametype  = string[127];
  63.   linetype      = string[80];
  64.  
  65. const
  66.   Title         = 'DEMO PICTURE SLIDESHOW';
  67.   inputquestion = 'Input file to use: ';
  68.   byebye        = 'Program Demo Terminated.';
  69.   confirmanswer = 'Using input file: ';
  70.   booboo        = 'Input file does not exist!';
  71.   badpicture    = 'Cannot locate picture file: ';
  72.   ExecError     = 'Cannot locate list maker module: ';
  73.   ExecMessage   = 'Executing Makelist.Com';
  74.  
  75. var
  76.   listfile      : text;              { input file variable }
  77.   infile        : file of BsaveRec;  { files which contain pictures }
  78.   execfile      : file;
  79.   TempPic       : BsaveRec;     { construct with which BSAVE stores pictures }
  80.   filename      : filenametype;
  81.   display       : PictureRec absolute $B800:$0000; { start of CGA regen }
  82.   ch            : char;                            { buffer memory }
  83.   i,time,
  84.   PaletteNo     : integer;
  85.  
  86. function center(str : linetype) : integer;
  87.   begin
  88.     center := 39-round(length(str)/2)
  89.   end;
  90.  
  91. procedure CursorOff;  { directly manipulates the CGA (color graphics card) }
  92.   begin
  93.     port[$3d4]:=10;   { 6845 crt controller ind reg;points to reg to rec }
  94.     port[$3d5]:=8;    { data which is output to reg here;strt scan ln=8  }
  95.     port[$3d4]:=11;   { index to reg for cursor stop scan ln             }
  96.     port[$3d5]:=7;    { stop scan line=7                                 }
  97.  end;
  98.  
  99. procedure CursorOn;   { directly manipulates the CGA (color graphics card) }
  100.   begin
  101.     port[$3d4]:=10;
  102.     port[$3d5]:=6;    { start scan line = 6 ( normal ) }
  103.     port[$3d4]:=11;
  104.     port[$3d5]:=7;    { stop scan line = 7 ( normal )  }
  105.   end;
  106.  
  107. procedure FixScreen;  { prepare to end program }
  108.   begin
  109.     textmode(C80);       { Reset color-text mode }
  110.     textcolor(14);       { I like bright yellow  }
  111.     textbackground(0);   { and black background  }
  112.     clrscr;
  113.     gotoxy(Center(byebye),12);
  114.     cursoroff;
  115.     write(byebye);
  116.     delay(1000);
  117.     gotoxy(1,24);
  118.     cursoron;
  119.     halt                 { End program           }
  120.   end;
  121.  
  122. procedure AbortCheck;
  123.   begin
  124.     for i := 1 to 300 do          { check for <ctrl>-c to abort program }
  125.       if keypressed then          { check alot! }
  126.         begin
  127.           read(kbd,ch);
  128.           if ch = #3 then fixscreen
  129.         end
  130.   end;
  131.  
  132. function Exist(filename: filenametype) : boolean; { check if a file exists }
  133.   var                                             { before trying to read it }
  134.     tempfile : file;
  135.     dummy    : integer;
  136.  
  137.   begin
  138.     assign(tempfile,filename);
  139.     {$I-}              { disable automatic generation of I/O checking code }
  140.     reset(tempfile);   { attempt to open file }
  141.     Exist:=(IOresult=0); { standard function IOresult give 0 if no error }
  142.     close(tempfile);   { just in case the file exists, it must be closed or   }
  143.     dummy := IOresult; { end up with too many open files and prog. will abort }
  144.     {$I+}              { re-enable automatic generation of I/O checking code  }
  145.   end;
  146.  
  147. begin  { Demo }
  148.  
  149.   clrscr;
  150.   gotoxy(center(Title),12);
  151.   cursoroff;
  152.   write(Title);
  153.   delay(2500);
  154.  
  155.   filename := paramstr(1);
  156.   for i := 1 to length(filename) do filename[i] := upcase(filename[i]);
  157.  
  158.   if filename = 'MAKELIST' then
  159.     begin
  160.       if Exist('makelist.com') then
  161.         begin
  162.           clrscr;
  163.           gotoxy(Center(ExecMessage),12);
  164.           write(ExecMessage);
  165.           delay(1000);
  166.           assign(execfile,'makelist.com');
  167.           execute(execfile)
  168.         end
  169.         else
  170.           begin
  171.             clrscr;
  172.             gotoxy(Center(ExecError+'Makelist.Com'),12);
  173.             cursoroff;
  174.             write(ExecError+'Makelist.Com!');
  175.             delay(1000)
  176.           end
  177.     end;
  178.  
  179.   if paramstr(1) <> '' then
  180.     filename := paramstr(1)      { get name of input file from command line }
  181.     else
  182.       begin
  183.         clrscr;                       { or ask what file to use }
  184.         gotoxy(Center(inputquestion),12);
  185.         write(inputquestion);
  186.         read(filename)
  187.       end;
  188.   if filename = '' then fixscreen; { if still no filename specified then end }
  189.  
  190.   if Exist(filename) then
  191.     begin
  192.       assign(listfile,filename);
  193.       reset(listfile)
  194.     end
  195.     else
  196.       begin
  197.         clrscr;
  198.         gotoxy(Center(booboo+filename),12);
  199.         write(booboo);
  200.         delay(2000);
  201.         fixscreen
  202.       end;
  203.  
  204.   clrscr;
  205.   gotoxy(Center(confirmanswer+filename),12);
  206.   write(confirmanswer,filename);   { tell user what filename (s)he chose }
  207.   cursoroff;                       { turn off cursor forn esthetic reasons }
  208.   delay(2000);
  209.   graphcolormode;
  210.  
  211.   repeat
  212.  
  213.     AbortCheck;
  214.     filename := '';              { get variable length filenames from 'list' }
  215.     read(listfile,ch);
  216.     while ch = #32 read(listfile,ch); { ignore leading spaces }
  217.     while ch <> #32 do
  218.       begin
  219.         AbortCheck;
  220.         filename := filename + ch;
  221.         read(listfile,ch)
  222.       end;
  223.  
  224.     readln(listfile,time,PaletteNo);  { get duration and palette number }
  225.  
  226.     if filename = '' then fixscreen;  { if no filename then abort }
  227.  
  228.     if Exist(filename+'.PIC') then
  229.       begin
  230.         assign(infile,filename+'.pic');   { assume .PIC extension     }
  231.         reset(infile);
  232.         read(infile,TempPic);        { read entire Bsaverec      }
  233.         abortcheck;
  234.         graphcolormode;
  235.         palette(paletteNo);
  236.         display := TempPic.Screen;   { throw away the 7 bytes (BsaveJunk) }
  237.         delay(time);
  238.         close(infile);               { don't forget to close the file or    }
  239.         AbortCheck;                  { will end up with too many open files }
  240.       end
  241.  
  242.       else
  243.         begin
  244.           textmode(c80);
  245.           clrscr;
  246.           gotoxy(Center(badpicture+filename+'.Pic'),12);
  247.           cursoroff;
  248.           write(badpicture+filename+'.Pic');
  249.           delay(1000)
  250.         end;
  251.    AbortCheck;
  252.  
  253.   until eof(listfile);
  254.  
  255.   fixscreen
  256.  
  257. end.  { Demo }
  258.